00100	C DISPLAY IMAGE -----------------------------------------------------
00200		SUBROUTINE DPYIMG(IMG)
00300		COMMON/DB/DPYBUF(600),L(3,200),M/KNT/KNT,TOTAL
00400		IMPLICIT INTEGER(A-Z)
00500		CALL DPYSET(1,DPYBUF,400)
00600		LVL=SON(IMG)
00700		PGN0=SON(LVL)
00800		PGN=PGN0
00900		M=0
01000	100	CALL DPYPGN(PGN)
01100		PGN=CCW(PGN)
01200		IF(PGN.NE.PGN0)GO TO 100
01290		KNT=KNT+1
01300		IF(KNT.LT.TOTAL)GO TO 38
01400		CALL DPYOUT(1)
01600		KNT=0
01700		TYPE 36
01800		ACCEPT 37,Q,TOTAL
01900	38	IF(Q.EQ.'S')GO TO 1
02000	37	FORMAT(A1,I)
02100	36	FORMAT(' <CR>=GO ON.'/)
02200		IF(Q.NE.'X')RETURN
02300		END FILE(1)
02400		CALL CONV
02500	1	L(3,M)=-1
02600	C  END OF OBJECT
02700		DO 2 K=1,M
02800	2	WRITE(21,3)L(1,K),L(2,K),L(3,K)
02900	3	FORMAT(2I8,I11)
03000		END
03100	
03200	C  <CR>=DO NOT SAVE IT,  S=YES,  X=EXIT
03300	C  NUMBER AFTER LETTER OR BLANK SAVES SEVERAL.
03400	
03500		SUBROUTINE SAVE(J,K,N)
03600		COMMON/DB/DPYBUF(600),L(3,200),M
03700		M=M+1
03800		L(1,M)=J
03900		L(2,M)=K
04000		L(3,M)=N
04100		END
04200	
04300	C DISPLAY POLYGON ---------------------------------------------------
04400		SUBROUTINE DPYPGN(PGN)
04500		IMPLICIT INTEGER(A-Z)
04550		COMMON/KNT/KNT,TOTAL
04600		DATA SIZE/5/,MUP/1388/,MLR/1912/
04700		V0=SON(PGN)
04800		V=V0
04900		R=MUP-ROW(V)/SIZE
05000		C=COL(V)/SIZE-MLR
05100		CALL SAVE(C,R,200000000)
05200		CALL AIVECT(C,R)
05300	100	V=CCW(V)
05400		R=MUP-ROW(V)/SIZE
05500		C=COL(V)/SIZE-MLR
05600		CALL SAVE(C,R,0)
05700		CALL AVECT(C,R)
05800		IF(V.NE.V0)GO TO 100
05900		END
06000	
12100		SUBROUTINE CONV
12110		COMMON/DB/MM(600),L(3,200),M/LL/LL
12400		DIMENSION IB(200),ITOP(10),MORE(1),JL(10)
12405		EQUIVALENCE(IB,L)
12410		DATA JL/'A    B    C    D    E    F    G    H    I
12455		1    J    '/,B/5.0/
12480		NM=0
12500	1000	DO 100 K=1,11
12600	100	ITOP(K)=0
12800		KJ=1
12900		KN=1
13000		ITOP(1)=1
13100	1	FORMAT(' TYPE OUTPUT FILE NAME --  '$)
13200	3	FORMAT(2F,I)
13300	2	FORMAT(A5)
13700	14	KM=KJ
13800	5	READ(21,3,END=91)X,Y,LL
14000	C  LL=-1=END OF ITEM
14700	
14720		J=ISCALE(X,B)
14760		K=ISCALE(Y,B)
14780		IF(LL.EQ.0.AND.K.EQ.KK.AND.J.EQ.JJ)GO TO 5
14790		JJ=J
14795		KK=K
14797	C  AVOIDS DUPLICATE POINTS
14800	6	KJ=KJ+1
14900		CALL REPACK(KJ,J,K,MM)
15000	C  /9  BECAUSE DRAWING PROG. MULTS BY 9
15010		IF(LL)GO TO 7
15100		GO TO 5
15110	
15120	16	NM=NM+2
15125		TYPE 92,NM
15130		GO TO 15
15140	C  CHANGES LAST CHAR. OF NAME AUTOMATICALLY
15200	
15210	CC9	IF(NM.EQ.0)GO TO 8
15255	91	IF(KJ.NE.1)GO TO 16
15300		TYPE 99
15400		CALL EXIT
15500	99	FORMAT(' DELETE FOR21.DAT -- AND *.DMD')
15900	7	KJ=KJ+1
16000		MM(KM)=KJ-KM
16050	CC	IF(KN.EQ.10)GO TO 8
16100		KN=KN+1
16200		ITOP(KN)=KJ
16300		IF(KN.LT.11.AND.KJ.LT.500)GO TO 14
16400	C  10 ITEMS IN A FILE.  WD LIMIT IS 400 -- ENDS FILE IF >340.
16500		IF(NM.NE.0)GO TO 16
16600	8	TYPE 1
16700		ACCEPT 2,NM
16800	15	CALL OFILE(1,NM)
16900		WRITE(1,10),ITOP
17000	10	FORMAT(' 9999 ',10I5)
17100		M=1
17200	11	M=M+1
17300		J=ITOP(M-1)
17400		K=ITOP(M)-1
17500		IF(K)GO TO 12
17600	C  0=END
17700		N=0
17800		DO 13 JJ=J,K
17900		N=N+1
18000	13	IB(N)=MM(JJ)
18100	CC	IB(1)=N
18200		CALL SAVE2(IB)
18300		GO TO 11
18325	12	KN=KN-1
18350		WRITE(1,92)(JL(K),K=1,KN)
18375	92    FORMAT(' 9999 ',10A5)
18400		END FILE 1
18410		GO TO 1000
18500		END
18600	
18700		SUBROUTINE SAVE2(M)
18800		DIMENSION M(1)
18900		J=7
19000		L=8
19100		DO 12 K=1,M(1),8
19200		IF(K+J.LT.M(1))GO TO 12
19300		J=M(1)-K
19400		L=J+1
19500	12	WRITE(1,11)L,(M(NM),NM=K,K+J)
19600		RETURN
19700	11	FORMAT(' 9999',I3,8I10)
19800		END
19900	
20000		SUBROUTINE REPACK(K,M,N,I)
20100		COMMON/LL/L
20200		DIMENSION I(1)
20300		M=M*10000
20400		IF(M)M=10000000-M
20500		IF(N)N=1000-N
20600		IF(L.GT.0)M=M+L
20700		I(K)=M+N
20800		RETURN
20900		END
21000	
21100		INTEGER FUNCTION ISCALE(X,B)
21105	C   FOR ROUND OFF  WHEN SCALING.
21110	CC	DATA B/9.0/
21200		A=.5
21300		IF(X)A=-A
21400		ISCALE=X/B+A
21500		END